home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hyperbole / kotl / klabel.el < prev    next >
Encoding:
Text File  |  1995-07-08  |  24.5 KB  |  680 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         klabel.el
  4. ;; SUMMARY:      Display label handling for koutlines.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     outlines, wp
  7. ;;
  8. ;; AUTHOR:       Bob Weiner & Kellie Clark
  9. ;;
  10. ;; ORIG-DATE:    17-Apr-94
  11. ;; LAST-MOD:     25-Jun-95 at 18:21:04 by Bob Weiner
  12. ;;
  13. ;; This file is part of Hyperbole.
  14. ;; Available for use and distribution under the same terms as GNU Emacs.
  15. ;;
  16. ;; Copyright (C) 1994-1995, Free Software Foundation, Inc.
  17. ;; Developed with support from Motorola Inc.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;;
  21. ;;   Klabels are absolute alpha labels, e.g. 1b3.
  22. ;;
  23. ;;   Kotl-labels are the last partial part of a klabel, e.g. 3.
  24. ;;
  25. ;;   Klabel-type determines the type of display label format within a
  26. ;;   koutline view.
  27. ;;
  28. ;; DESCRIP-END.
  29.  
  30. ;;; ************************************************************************
  31. ;;; Public variables
  32. ;;; ************************************************************************
  33.  
  34. (defvar klabel-type:changing-flag nil
  35.   "Non-nil only while the label type in the current view is being changed.")
  36.  
  37. ;;; ************************************************************************
  38. ;;; Public functions
  39. ;;; ************************************************************************
  40.  
  41. ;;;
  42. ;;; klabel - koutline display labels
  43. ;;;
  44.  
  45. (defun klabel:child (label)
  46.   "Return LABEL's child cell label."
  47.   (funcall (kview:get-attr kview 'label-child) label))
  48.  
  49. (defun klabel:increment (label)
  50.   "Return LABEL's sibling label."
  51.   (funcall (kview:get-attr kview 'label-increment) label))
  52.  
  53. (defun klabel:parent (label)
  54.   "Return LABEL's parent label."
  55.   (funcall (kview:get-attr kview 'label-parent) label))
  56.  
  57. (defun klabel-type:child (label-type)
  58.   "Return function which computes child cell label of LABEL-TYPE."
  59.   (cond ((memq label-type '(alpha legal partial-alpha))
  60.      (intern-soft (concat "klabel:child-"
  61.                   (symbol-name label-type))))
  62.     ((eq label-type 'no)
  63.      (function (lambda (label) "")))
  64.     ((eq label-type 'star)
  65.      (function (lambda (label) (concat label "*"))))
  66.     ((eq label-type 'id)
  67.      (function
  68.       (lambda (label)
  69.         (error
  70.          "(klabel:child-id): Can't compute child of idstamp label"))))
  71.     (t (error
  72.         "(klabel-type:child): Invalid label type setting: '%s'"
  73.         label-type))))
  74.  
  75. (defun klabel-type:increment (label-type)
  76.   "Return function which computes sibling cell label of LABEL-TYPE."
  77.   (cond ((memq label-type '(alpha legal partial-alpha))
  78.      (intern-soft (concat "klabel:increment-"
  79.                   (symbol-name label-type))))
  80.     ((eq label-type 'no)
  81.      (function
  82.       (lambda (label)
  83.         (if (equal label "0")
  84.         (error "(klabel:increment-no): 0 cell cannot have a sibling")
  85.           ""))))
  86.     ((eq label-type 'star)
  87.      (function
  88.       (lambda (label)
  89.         (if (string-equal label "0")
  90.         (error "(klabel:increment-star): 0 cell cannot have a sibling")
  91.           label))))
  92.     ((eq label-type 'id)
  93.      (function
  94.       (lambda (label)
  95.         (if (string-equal label "0")
  96.         (error "(klabel:increment-no): 0 cell cannot have a sibling")
  97.           (error "(klabel:increment-id): Can't compute sibling of idstamp label")))))
  98.     (t (error
  99.         "(klabel:increment): Invalid label type setting: '%s'"
  100.         label-type))))
  101.  
  102. (defun klabel-type:parent (label-type)
  103.   "Return function which computes parent cell label of LABEL-TYPE."
  104.   (cond ((memq label-type '(alpha legal partial-alpha))
  105.      (intern-soft (concat "klabel:parent-"
  106.                   (symbol-name label-type))))
  107.     ((eq label-type 'no)
  108.      (function
  109.       (lambda (label)
  110.         (if (equal label "0")
  111.         (error "(klabel:parent-no): 0 cell cannot have a parent")
  112.           ""))))
  113.     ((eq label-type 'star)
  114.      (function
  115.       (lambda (label)
  116.         (if (string-equal label "0")
  117.         (error "(klabel:parent-star): 0 cell cannot have a parent")
  118.           (substring label 0 (1- (length label)))))))
  119.     ((eq label-type 'partial-alpha)
  120.      (function
  121.       (lambda (label)
  122.         (error
  123.          "(klabel:parent-partial-alpha): Can't compute parent of partial alpha label"))))
  124.     ((eq label-type 'id)
  125.      (function
  126.       (lambda (label)
  127.         (error
  128.          "(klabel:parent-id): Can't compute parent of idstamp label"))))
  129.     (t (error
  130.         "(klabel-type:parent): Invalid label type setting: '%s'"
  131.         label-type))))
  132.  
  133. ;;;
  134. ;;; alpha klabels
  135. ;;;
  136.  
  137. (defun klabel:child-alpha (label)
  138.   "Return label for first child of alpha LABEL."
  139.   (if (or (string-equal label "0")
  140.       (string-equal label ""))
  141.       "1"
  142.     (concat label (if (< (aref label (1- (length label))) ?a)
  143.               "a" "1"))))
  144.  
  145. (defun klabel:increment-alpha (alpha-label)
  146.   "Increment full ALPHA-LABEL by one and return."
  147.   (if (string-equal alpha-label "0")
  148.       (error "(klabel:increment-alpha): 0 cell cannot have a sibling")
  149.     (let ((kotl-label (klabel:to-kotl-label alpha-label)))
  150.       (concat (substring alpha-label 0 (- (length kotl-label)))
  151.           (kotl-label:increment kotl-label 1)))))
  152.  
  153. (defun klabel:parent-alpha (label)
  154.   "Return parent label of full alpha LABEL."
  155.   (cond ((or (string-equal label "0")
  156.          (string-equal label ""))
  157.      (error "(klabel:parent-alpha): 0 cell cannot have a parent"))
  158.     ((kotl-label:integer-p label)  ;; level 1 label
  159.      "0")
  160.     (t (substring label 0 (- (length (klabel:to-kotl-label label)))))))
  161.  
  162. ;;;
  163. ;;; partial-alpha klabels
  164. ;;;
  165.  
  166. (fset 'klabel:child-partial-alpha 'kotl-label:child)
  167.  
  168. (defun klabel:increment-partial-alpha (label)
  169.   "Increment partial alpha LABEL by one and return."
  170.   (if (string-equal label "0")
  171.       (error "(klabel:increment-partial-alpha): 0 cell cannot have a sibling")
  172.     (kotl-label:increment label 1)))
  173.  
  174. ;;;
  175. ;;; legal klabels
  176. ;;;
  177.  
  178. (defun klabel:child-legal (label)
  179.   "Return label for first child of legal LABEL."
  180.   (if (or (string-equal label "0")
  181.       (string-equal label ""))
  182.       "1"
  183.     (concat label ".1")))
  184.  
  185. (defun klabel:increment-legal (label)
  186.   "Increment full legal LABEL by one and return."
  187.   (cond ((string-equal label "0")
  188.      (error "(klabel:increment-legal): 0 cell cannot have a sibling"))
  189.     ((string-match "[0-9]+$" label)
  190.      (concat (substring label 0 (match-beginning 0))
  191.          (int-to-string
  192.           (1+ (string-to-int (substring label (match-beginning 0)))))))
  193.     (t (error "(klabel:increment-legal): Invalid label, '%s'" label))))
  194.  
  195. (defun klabel:parent-legal (label)
  196.   "Return parent label of full legal LABEL."
  197.   (cond ((or (string-equal label "0")
  198.          (string-equal label ""))
  199.      (error "(klabel:parent-legal): 0 cell cannot have a parent"))
  200.     ((kotl-label:integer-p label)  ;; level 1 label
  201.      "0")
  202.     (t (substring label 0 (string-match "\\.[0-9]+$" label)))))
  203.  
  204. ;;;
  205. ;;; klabel-type - Sets display label format and converts among formats
  206. ;;;
  207. ;; Default label-type to use for new views.
  208. ;; It must be one of the following symbols:
  209. ;;   no              for no labels,
  210. ;;   id              for permanent idstamp labels, e.g. 001, 002, etc.
  211. ;;   alpha           for '1a2' full alphanumeric labels
  212. ;;   legal           for '1.1.2' labels
  213. ;;   partial-alpha   for partial alphanumeric labels, e.g. '2' for node '1a2'
  214. ;;   star            for multi-star labeling, e.g. '***'.
  215.  
  216. ;;
  217. ;; Functions to compute sibling and child labels for particular label types.
  218. ;;
  219. (defun klabel-type:function (&optional label-type)
  220.   "Return function which will return display label for current cell.
  221. Label format is optional LABEL-TYPE or the default label type for the current view.
  222.  
  223. Function signature is: (func prev-label &optional child-p), where prev-label
  224. is the display label of the cell preceding the current one and child-p is
  225. non-nil if cell is to be the child of the preceding cell."
  226.   (or label-type (setq label-type (kview:label-type kview)))
  227.   (cond ((eq label-type 'no)
  228.      (function (lambda (prev-label &optional child-p)
  229.              "")))
  230.     ((eq label-type 'partial-alpha)
  231.      (function (lambda (prev-label &optional child-p)
  232.              (if child-p
  233.              (if (kotl-label:integer-p prev-label)
  234.                  "a" "1")
  235.                (kotl-label:increment prev-label 1)))))
  236.     ((eq label-type 'id)
  237.      (function (lambda (prev-label &optional child-p)
  238.              (format "0%d" (kcell-view:idstamp)))))
  239.     (t (intern-soft (concat "klabel-type:"
  240.                 (symbol-name label-type) "-label")))))
  241.  
  242. (defun klabel-type:alpha-label (prev-label &optional child-p)
  243.   "Return full alphanumeric label, e.g. 1a2, for cell following PREV-LABEL's cell.
  244. With optional CHILD-P, return label for first child cell of PREV-LABEL cell."
  245.   (if child-p
  246.       (klabel:child prev-label)
  247.     (klabel:increment prev-label)))
  248.  
  249. (defun klabel-type:legal-label (prev-label &optional child-p)
  250.   "Return full legal label, e.g. 1.1.2, for cell following PREV-LABEL's cell.
  251. With optional CHILD-P, return label for first child cell of PREV-LABEL cell."
  252.   (if child-p
  253.       (if (string-equal prev-label "0")
  254.       "1"
  255.     (concat prev-label ".1"))
  256.     (let* ((last-part (string-match "[0-9]+$" prev-label))
  257.        (partial-legal (substring prev-label last-part))
  258.        (next (kotl-label:create (1+ (string-to-int partial-legal)))))
  259.       (if (equal last-part prev-label)
  260.       next
  261.     (concat (substring prev-label 0 last-part) next)))))
  262.  
  263. (defun klabel-type:to-label-end (&optional label-type)
  264.   "Return function which will search backward to a the end of a cell's label.
  265. Label format is optional LABEL-TYPE or the default label type for the current view.
  266.  
  267. Function signature is: ().  It takes no arguments and begins the search from point."
  268.   (or label-type (setq label-type (kview:label-type kview)))
  269.   (or (cdr (assq label-type
  270.          (list
  271.           (cons
  272.            'alpha
  273.            (function
  274.             (lambda ()
  275.               (if (re-search-backward
  276.                "\\(\\`\\|[\n\^M][\n\^M]\\)[ \t]*[1-9][0-9a-zA-Z]*"
  277.                nil t)
  278.               (goto-char (match-end 0))))))
  279.           (cons
  280.            'legal
  281.            (function
  282.             (lambda ()
  283.               (if (re-search-backward
  284.                "\\(\\`\\|[\n\^M][\n\^M]\\)[ \t]*[0-9]+\\(\\.[0-9]+\\)*"
  285.                nil t)
  286.               (goto-char (match-end 0))))))
  287.             (cons
  288.              'star
  289.              (function
  290.               (lambda ()
  291.             (if (re-search-backward
  292.                  "\\(\\`\\|[\n\^M][\n\^M]\\)[ \t]*\\*+" nil t)
  293.                 (goto-char (match-end 0))))))
  294.             (cons
  295.              'no
  296.              (function
  297.               (lambda ()
  298.             (goto-char
  299.              (if (and (not hyperb:lemacs-p)
  300.                   (string-lessp emacs-version "19.22"))
  301.                  (kproperty:previous-single-change (point) 'kcell)
  302.                ;; (GNU Emacs V19.22 / Lucid Emacs V19.9) or greater
  303.                (- (kproperty:previous-single-change
  304.                    (point) 'kcell) 1))))))
  305.             (cons
  306.              'partial-alpha
  307.              (function
  308.               (lambda ()
  309.             (if (re-search-backward
  310.                  "\\(\\`\\|[\n\^M][\n\^M]\\)[ \t]*[0-9]+\\|[a-zA-Z]+"
  311.                  nil t)
  312.                 (goto-char (match-end 0))))))
  313.             (cons
  314.              'id
  315.              (function
  316.               (lambda ()
  317.             (if (re-search-backward
  318.                  "\\(\\`\\|[\n\^M][\n\^M]\\)[ \t]*0[0-9]+" nil t)
  319.                 (goto-char (match-end 0)))))))))
  320.     (error "(kview:to-label-end): Invalid label type: '%s'" label-type)))
  321.  
  322. (defun klabel-type:star-label (prev-label &optional child-p)
  323.   "Return full star label, e.g. ***, for cell following PREV-LABEL's cell.
  324. With optional CHILD-P, return label for first child cell of PREV-LABEL cell."
  325.   (if child-p
  326.       (concat prev-label "*")
  327.     prev-label))
  328.  
  329. ;;
  330. ;; Functions to compute labels for cells following point and for all cells in
  331. ;; a view.
  332. ;;
  333.  
  334. (defun klabel-type:set-labels (label-type)
  335.   "Replace labels of all cells in current view with those of LABEL-TYPE (a symbol)."
  336.   (let (first-label)
  337.     (save-excursion
  338.       (goto-char (point-min))
  339.       (goto-char (kcell-view:start))
  340.       (setq first-label
  341.         (cond ((memq label-type '(alpha legal partial-alpha))
  342.            "1")
  343.           ((eq label-type 'id) (kcell-view:idstamp))
  344.           ((eq label-type 'no) "")
  345.           ((eq label-type 'star) "*")
  346.           (t (error
  347.               "(klabel-type:set-labels): Invalid label type: '%s'"
  348.               label-type))))
  349.       (let ((klabel-type:changing-flag t))
  350.     (klabel-type:update-labels-from-point label-type first-label)))))
  351.  
  352. (defun klabel-type:set-alpha (current-cell-label label-sep-len current-indent
  353.                   per-level-indent &optional current-tree-only)
  354.   "Set the labels of current cell, its following siblings and their subtrees.
  355. CURRENT-CELL-LABEL is the label to display for the current cell.
  356. LABEL-SEP-LEN is the length of the separation between a cell's label
  357. and the start of its contents." 
  358.   (let (label-prefix label-suffix suffix-val suffix-function opoint)
  359.     (if current-cell-label
  360.     (setq label-suffix (klabel:to-kotl-label current-cell-label)
  361.           label-prefix (substring current-cell-label
  362.                       0 (- (length label-suffix)))
  363.           suffix-function (if (kotl-label:integer-p label-suffix)
  364.                   (progn (setq suffix-val
  365.                            (string-to-int label-suffix))
  366.                      'int-to-string)
  367.                 (setq suffix-val
  368.                       (kotl-label:alpha-to-int label-suffix))
  369.                 'kotl-label:int-to-alpha)))
  370.     (while current-cell-label
  371.       ;; Set current cell's label.
  372.       (klabel:set current-cell-label label-sep-len)
  373.       ;; Process any subtrees of current cell.
  374.       (if (kcell-view:child label-sep-len)
  375.       ;; Recurse over subtree.
  376.       (klabel-type:set-alpha
  377.        (klabel:child-alpha current-cell-label)
  378.        label-sep-len
  379.        (+ current-indent per-level-indent)
  380.        per-level-indent))
  381.       ;; Process next sibling of current cell if any.
  382.       (setq opoint (point))
  383.       (if (and (not current-tree-only)
  384.            (kcell-view:next nil label-sep-len)
  385.            (= current-indent (kcell-view:indent nil label-sep-len)))
  386.       (setq suffix-val (1+ suffix-val)
  387.         label-suffix (funcall suffix-function suffix-val)
  388.         current-cell-label (concat label-prefix label-suffix))
  389.     (goto-char opoint)
  390.     (setq current-cell-label nil)))))
  391.  
  392. (defun klabel-type:set-id (current-cell-label label-sep-len &rest ignore)
  393.   "Set the labels of current cell, its following siblings and their subtrees.
  394. CURRENT-CELL-LABEL is the label to display for the current cell."
  395.   ;; Only need to do this when switching from one label type to another,
  396.   ;; i.e. when every cell label will be updated.  So if not starting with the
  397.   ;; first cell, do nothing.
  398.   (if (kotl-mode:first-cell-p)
  399.       (while (and (klabel:set (kcell-view:idstamp) label-sep-len)
  400.           (kcell-view:next nil label-sep-len)))))
  401.  
  402. (defun klabel-type:set-legal (current-cell-label label-sep-len current-indent
  403.                   per-level-indent &optional current-tree-only)
  404.   "Set the labels of current cell, its following siblings and their subtrees.
  405. CURRENT-CELL-LABEL is the label to display for the current cell.
  406. LABEL-SEP-LEN is the length of the separation between a cell's label
  407. and the start of its contents." 
  408.   (let (label-prefix label-suffix suffix-val opoint)
  409.     (if current-cell-label
  410.     (setq label-suffix (klabel:to-kotl-label current-cell-label)
  411.           label-prefix (substring current-cell-label
  412.                       0 (- (length label-suffix)))
  413.           suffix-val (string-to-int label-suffix)))
  414.     (while current-cell-label
  415.       ;; Set current cell's label.
  416.       (klabel:set current-cell-label label-sep-len)
  417.       ;; Process any subtrees of current cell.
  418.       (if (kcell-view:child label-sep-len)
  419.       ;; Recurse over subtree.
  420.       (klabel-type:set-legal
  421.        (klabel:child-legal current-cell-label)
  422.        label-sep-len
  423.        (+ current-indent per-level-indent)
  424.        per-level-indent))
  425.       ;; Process next sibling of current cell if any.
  426.       (setq opoint (point))
  427.       (if (and (not current-tree-only)
  428.            (kcell-view:next nil label-sep-len)
  429.            (= current-indent (kcell-view:indent nil label-sep-len)))
  430.       (setq suffix-val (1+ suffix-val)
  431.         label-suffix (int-to-string suffix-val)
  432.         current-cell-label (concat label-prefix label-suffix))
  433.     (goto-char opoint)
  434.     (setq current-cell-label nil)))))
  435.  
  436. (defun klabel-type:set-no (current-cell-label label-sep-len &rest ignore)
  437.   "Set the labels of current cell, its following siblings and their subtrees.
  438. CURRENT-CELL-LABEL is the label to display for the current cell."
  439.   ;; Only need to do this when switching from one label type to another,
  440.   ;; i.e. when every cell label will be updated.  So if not starting with the
  441.   ;; first cell, do nothing.
  442.   (if (kotl-mode:first-cell-p)
  443.       (while (and (klabel:set "" label-sep-len)
  444.           (kcell-view:next nil label-sep-len)))))
  445.  
  446. (defun klabel-type:set-partial-alpha (current-cell-label label-sep-len
  447.                                       current-indent per-level-indent
  448.                       &optional current-tree-only)
  449.   "Set the labels of current cell, its following siblings and their subtrees.
  450. CURRENT-CELL-LABEL is the label to display for the current cell.
  451. LABEL-SEP-LEN is the length of the separation between a cell's label
  452. and the start of its contents."
  453.   (let (label-suffix suffix-val suffix-function opoint)
  454.     (if current-cell-label
  455.     (setq label-suffix current-cell-label
  456.           suffix-function (if (kotl-label:integer-p label-suffix)
  457.                   (progn (setq suffix-val
  458.                            (string-to-int label-suffix))
  459.                      'int-to-string)
  460.                 (setq suffix-val
  461.                       (kotl-label:alpha-to-int label-suffix))
  462.                 'kotl-label:int-to-alpha)))
  463.     (while current-cell-label
  464.       ;; Set current cell's label.
  465.       (klabel:set current-cell-label label-sep-len)
  466.       ;; Process any subtrees of current cell.
  467.       (if (kcell-view:child label-sep-len)
  468.       ;; Recurse over subtree.
  469.       (klabel-type:set-partial-alpha
  470.        (klabel:child-partial-alpha current-cell-label)
  471.        label-sep-len
  472.        (+ current-indent per-level-indent)
  473.        per-level-indent))
  474.       ;; Process next sibling of current cell if any.
  475.       (setq opoint (point))
  476.       (if (and (not current-tree-only)
  477.            (kcell-view:next nil label-sep-len)
  478.            (= current-indent (kcell-view:indent nil label-sep-len)))
  479.       (setq suffix-val (1+ suffix-val)
  480.         label-suffix (funcall suffix-function suffix-val)
  481.         current-cell-label label-suffix)
  482.     (goto-char opoint)
  483.     (setq current-cell-label nil)))))
  484.  
  485. (defun klabel-type:set-star (current-cell-label label-sep-len &rest ignore)
  486.   "Set the labels of current cell, its following siblings and their subtrees.
  487. CURRENT-CELL-LABEL is the label to display for the current cell.
  488. LABEL-SEP-LEN is the length of the separation between a cell's label
  489. and the start of its contents." 
  490.   ;; Only need to do this when switching from one label type to another,
  491.   ;; i.e. when every cell label will be updated.  So if not starting with the
  492.   ;; first cell, do nothing.
  493.   (if (kotl-mode:first-cell-p)
  494.       (while (and (klabel:set (make-string
  495.                    (kcell-view:level nil label-sep-len) ?*)
  496.                   label-sep-len)
  497.           (kcell-view:next nil label-sep-len)))))
  498.  
  499. (defun klabel-type:update-labels (current-cell-label)
  500.   "Update the labels of current cell, its following siblings and their subtrees.
  501. CURRENT-CELL-LABEL is the label to display for the current cell.
  502. If, however, it is \"0\", then all cell labels are updated."
  503.   (let ((label-type (kview:label-type kview)))
  504.     (if (string-equal current-cell-label "0")
  505.     ;; Update all cells in view.
  506.     (klabel-type:set-labels label-type)
  507.       ;; Update current tree and its siblings only.
  508.       (klabel-type:update-labels-from-point
  509.        label-type current-cell-label))))
  510.  
  511. (defun klabel-type:update-tree-labels (current-cell-label)
  512.   "Update the labels of current cell and its subtree.
  513. CURRENT-CELL-LABEL is the label to display for the current cell.
  514. Use '(klabel-type:update-labels "0")' to update all cells in an outline."
  515.   (let ((label-type (kview:label-type kview))
  516.     (label-sep-len (kview:label-separator-length kview)))
  517.     (save-excursion
  518.       (funcall (intern-soft (concat "klabel-type:set-"
  519.                     (symbol-name label-type)))
  520.            first-label label-sep-len
  521.            (kcell-view:indent nil label-sep-len)
  522.            (kview:level-indent kview)
  523.            ;; Update current tree only.
  524.            t))))
  525.  
  526. ;;;
  527. ;;; kotl-label--the part of a full label which represents a
  528. ;;;             kcell's relative position in the koutline hierarchy,
  529. ;;;             e.g. the full label "1a2" has kotl-label "2".
  530. ;;;
  531. (defun kotl-label:alpha-to-int (alpha-label)
  532.   "Return integer value of ALPHA-LABEL, e.g. `b' returns 2.
  533. Assumes ALPHA-LABEL is alphabetic."
  534.   (let ((power (length alpha-label))
  535.     (digit 0)
  536.     (min (1- ?a)))
  537.     (apply '+ (mapcar
  538.            (function (lambda (chr)
  539.                (setq digit (- chr min)
  540.                  power (1- power))
  541.                (* (apply '* (make-list power 26)) digit)
  542.                ))
  543.            alpha-label))))
  544.  
  545. (defun kotl-label:alpha-p (label)
  546.   "Return LABEL if LABEL is composed of all alphabetic characters, else return nil."
  547.   (if (string-match "\\`[a-zA-Z]+\\'" label) label))
  548.  
  549. (defun kotl-label:child (label)
  550.   "Return child label of partial alpha LABEL."
  551.   (cond ((or (string-equal label "0")
  552.          (string-equal label ""))
  553.      "1")
  554.     ((kotl-label:integer-p label) "a")
  555.     (t "1")))
  556.  
  557. (defun kotl-label:create (int-or-string)
  558.   "Return new kcell label from INT-OR-STRING."
  559.   (cond ((integerp int-or-string) (int-to-string int-or-string))
  560.     ((equal int-or-string "") "0")
  561.     (t int-or-string)))
  562.  
  563. (defun kotl-label:increment (label n)
  564.   "Return LABEL incremented by N.
  565. For example, if N were 1, 2 would become 3, z would become aa, and aa would
  566. become bb.  If N were -2, 4 would become 2, etc.
  567. LABEL must be >= 1 or >= a.  If LABEL is decremented below 1 or a, an error
  568. is signaled."
  569.   (if (not (kotl-label:is-p label))
  570.       (error
  571.        "(kotl-label:increment): First arg, '%s', must be a kotl-label."
  572.        label))
  573.   (let ((int-p) (val 0))
  574.     (if (or (setq int-p (kotl-label:integer-p label))
  575.         (kotl-label:alpha-p label))
  576.     ;; Test if trying to decrement below 1 or a.
  577.     (if int-p
  578.         (progn (setq int-p (string-to-int label))
  579.            (if (> (setq val (+ int-p n)) 0)
  580.                (kotl-label:create val)
  581.              (error "(kotl-label:increment): Decrement of '%s' by '%d' is less than 1." label n)))
  582.       ;; alpha-p
  583.       (if (<= 0 (setq val (+ n (kotl-label:alpha-to-int label))))
  584.           (kotl-label:create
  585.            (kotl-label:int-to-alpha val))
  586.         (error "(kotl-label:increment): Decrement of '%s' by '%d' is illegal." label n)))
  587.       (error "(kotl-label:increment): label, '%s', must be all digits or alpha characters" label))))
  588.  
  589. (defun kotl-label:increment-alpha (label)
  590.   "Return alphabetic LABEL incremented by 1.
  591. For example, z would become aa, and aa would become bb.  LABEL must be >= a." 
  592.   (kotl-label:int-to-alpha
  593.    (1+ (kotl-label:alpha-to-int label))))
  594.  
  595. (defun kotl-label:increment-int (int-string)
  596.   "Return INT-STRING label incremented by 1.
  597. For example, \"14\" would become \"15\"."
  598.   (int-to-string (1+ (string-to-int int-string))))
  599.  
  600. (defun kotl-label:integer-p (label)
  601.   "Return LABEL iff LABEL is composed of all digits, else return nil."
  602.   (if (string-match "\\`[0-9]+\\'" label) label))
  603.  
  604. ;; This handles partial alphabetic labels with a maximum single level
  605. ;; sequence of 17575 items, which = (1- (expt 26 3)), after which it gives
  606. ;; invalid results.  This should be large enough for any practical cases.
  607.  
  608. (defun kotl-label:int-to-alpha (n)
  609.   "Return alphabetic representation of N as a string.
  610. N may be an integer or a string containing an integer."
  611.   (if (stringp n) (setq n (string-to-int n)))
  612.   (let ((lbl "") pow26 exp26 quotient remainder)
  613.     (if (= n 0)
  614.     ""
  615.       (setq pow26 (floor (kotl-label:log26
  616.               (if (= (mod (1- n) 26) 0) n (1- n)))))
  617.       (while (>= pow26 0)
  618.     (setq exp26 (expt 26 pow26)
  619.           quotient (floor (/ n exp26))
  620.           remainder (mod n exp26))
  621.     (if (= remainder 0)
  622.         (setq quotient (- quotient (1+ pow26))
  623.           n 26)
  624.       (setq n remainder
  625.         quotient (max 0 (1- quotient))))
  626.     (setq lbl (concat lbl (char-to-string (+ quotient ?a)))
  627.           pow26 (1- pow26)))
  628.       lbl)))
  629.  
  630. (defun kotl-label:is-p (object)
  631.   "Return non-nil if OBJECT is a KOTL-LABEL."
  632.   (stringp object))
  633.  
  634.  
  635.  
  636. ;;; ************************************************************************
  637. ;;; Private functions
  638. ;;; ************************************************************************
  639.  
  640. (defun klabel:set (new-label &optional label-sep-len)
  641.   "Replace label displayed in cell at point with NEW-LABEL, which may be a different label type.
  642. Return NEW-LABEL string."
  643.   (let ((modified (buffer-modified-p))
  644.     (buffer-read-only)
  645.     (thru-label (- (kcell-view:indent nil label-sep-len)
  646.                (or label-sep-len
  647.                (kview:label-separator-length kview)))))
  648.     (save-excursion
  649.       (kcell-view:to-label-end)
  650.       ;; delete backwards thru label
  651.       (delete-backward-char thru-label)
  652.       ;; replace with new label, right justified
  653.       (insert (format (format "%%%ds" thru-label) new-label)))
  654.     (set-buffer-modified-p modified)
  655.     new-label))
  656.  
  657. (defun klabel:to-kotl-label (label)
  658.   "Given full alpha or legal LABEL, return rightmost part, called a kotl-label.
  659. For example, the full label \"1a2\" has kotl-label \"2\", as does \"1.1.2\"."
  660.   (if (string-match "[0-9]+$\\|[a-zA-Z]+$" label)
  661.       (substring label (match-beginning 0))
  662.     (error "(klabel:to-kotl-label): Invalid label, '%s'" label)))
  663.  
  664. (defun klabel-type:update-labels-from-point (label-type first-label)
  665.   (let ((label-sep-len (kview:label-separator-length kview)))
  666.     (save-excursion
  667.       (funcall (intern-soft (concat "klabel-type:set-"
  668.                     (symbol-name label-type)))
  669.            first-label label-sep-len
  670.            (kcell-view:indent nil label-sep-len)
  671.            (kview:level-indent kview)))))
  672.  
  673. (defun kotl-label:log26 (n)
  674.   "Return log base 26 of integer N."
  675.   (/ (log10 n)
  676.      ;; Next line = (log10 26.514147167125703)
  677.      1.423477662509912))
  678.  
  679. (provide 'klabel)
  680.